﻿Imports System.Reflection

Public Class AssemblyRegister


#Region "GlobalAvalibleObject"
    Private _argumentless_retrivers As New Dictionary(Of Type, Func(Of Object))

    Public Function getArgumentLessRetriver(type As Type) As Func(Of Object)
        Return _argumentless_retrivers(type)
    End Function

    Public Function hasArgumentLessRetriver(type As Type) As Boolean
        Return _argumentless_retrivers.ContainsKey(type)
    End Function

    Private Sub registerGlobalAvalibleObject(type As Type)

        For Each implementation_attr As GlobalAvalibleObjectImplementation In type.GetCustomAttributes(GetType(GlobalAvalibleObjectImplementation), False)
            'checking if they are registering themself 
            Dim implementing As Type = If(implementation_attr.implementation_of Is Nothing, type, implementation_attr.implementation_of)
            'making sure then what they are implementing is already register
            If implementing IsNot type AndAlso Not _argumentless_retrivers.ContainsKey(implementing) Then
                registerGlobalAvalibleObject(implementing)
                If Not _argumentless_retrivers.ContainsKey(implementing) Then Throw New Exception("the type " & type.FullName & " what to implement " & implementing.FullName & " which is not a " & GetType(GlobalAvalibleObject).Name)
            End If

            Dim retriver As Func(Of Object) = If(_argumentless_retrivers.ContainsKey(implementing), _argumentless_retrivers(implementing), Nothing)
            If retriver Is Nothing OrElse implementation_attr.overrides_exsisting Then

                Dim mi As MethodInfo = type.getFirstMethodWithAttribute(Of GlobalAvalibleObjectConstructor)()

                If mi Is Nothing AndAlso Not implementation_attr.singleton Then
                    Throw New Exception(type.FullName & " is not a " & GetType(GlobalAvalibleObject).Name & " sigleton object but I could not find a method marked with " & GetType(GlobalAvalibleObjectConstructor).Name)
                End If

                If mi IsNot Nothing AndAlso Not mi.IsStatic Then
                    Throw New Exception(mi.Name & " of " & type.FullName & " is markend with " & GetType(GlobalAvalibleObject).Name & " but is not static method")
                End If

                Dim create_instance As Func(Of Object)

                If mi IsNot Nothing Then
                    create_instance = [Delegate].CreateDelegate(GetType(Func(Of Object)), mi)
                Else
                    create_instance = Function()
                                          Return Activator.CreateInstance(type)
                                      End Function
                End If

                If implementation_attr.singleton Then
                    'let's not instance it now but as soon as it is called and only ones
                    retriver = Function()
                                   Dim instance As Object = create_instance()
                                   Dim return_instance As Func(Of Object) = Function()
                                                                                Return instance
                                                                            End Function
                                   _argumentless_retrivers(implementing) = return_instance
                                   Return instance
                               End Function
                Else
                    retriver = create_instance
                End If
                _argumentless_retrivers(implementing) = retriver
            End If

        Next
        Dim global_attr As GlobalAvalibleObject = type.GetCustomAttributes(GetType(GlobalAvalibleObject), False).FirstOrDefault
        If global_attr Is Nothing Then Exit Sub
        If Not _argumentless_retrivers.ContainsKey(type) Then
            _argumentless_retrivers(type) = Nothing
        End If

    End Sub
#End Region

    Private _registered_assemblies As IList(Of Assembly) = New List(Of Assembly)
    Public Function getAssemblyRegistered() As IEnumerable(Of Assembly)
        Return New List(Of Assembly)(_registered_assemblies)
    End Function


    Public actor_storages As New RegistrationActorStorage

    Public Sub Register(ass As Assembly)

        _registered_assemblies.Add(ass)

        'first global objects
        For Each type As Type In ass.GetTypes()
            registerGlobalAvalibleObject(type)
        Next
        'all the rest
        Dim actors As New HashSet(Of Type)
        For Each type As Type In ass.GetTypes()
            registerType(type)
            If type.GetInterface(GetType(IRegistrationActor).FullName) IsNot Nothing Then actors.Add(type)
        Next



        For Each type As Type In actors
            Dim instance As IRegistrationActor = actor_storages.getRegistrationActor(type)
            If instance Is Nothing Then Continue For
            instance.act()
        Next

    End Sub

    Public Sub New()
        Me.Register(Me.GetType.Assembly)
    End Sub

    Private _attributes As New Dictionary(Of Type, HashSet(Of Type))
    Private _childs As New Dictionary(Of Type, HashSet(Of Type))
    Private _mystery_attributes As New Dictionary(Of Type, HashSet(Of MysteryClassAttribute))
    Private _mystery_attributes_dict As New Dictionary(Of Type, Dictionary(Of Type, MysteryClassAttribute))

    Private _mystery_property_attributes As New Dictionary(Of Type, HashSet(Of MysteryPropertyAttribute))
    Private _mystery_property_attributes_map As New Dictionary(Of PropertyInfo, HashSet(Of MysteryPropertyAttribute))

    Public Sub addAttributeToClass(Of AttrType As {MysteryClassAttribute, New}, ClassType)(Optional attr As AttrType = Nothing)
        If attr Is Nothing Then attr = New AttrType
        If Not _attributes.ContainsKey(GetType(AttrType)) Then _attributes(GetType(AttrType)) = New HashSet(Of Type)
        _attributes(GetType(AttrType)).Add(GetType(ClassType))
        attr.used_in = GetType(ClassType)
        attr.setUp()
        _mystery_attributes(GetType(ClassType)).Add(attr)
        _mystery_attributes_dict(GetType(ClassType))(attr.GetType()) = attr
    End Sub

    Public Sub addAttributeToProperty(Of AttrType As {MysteryPropertyAttribute, New})(pi As PropertyInfo, Optional attr As AttrType = Nothing)
        If attr Is Nothing Then attr = New AttrType
        Dim generic_helper_type As Type = GetType(MysteryPropertyAttributeHelper(Of ,))

        If Not _mystery_property_attributes_map.ContainsKey(pi) Then _mystery_property_attributes_map(pi) = New HashSet(Of MysteryPropertyAttribute)

        If String.IsNullOrEmpty(attr.name) Then attr.name = pi.Name
        attr.used_in = pi
        Dim this_property As Type = generic_helper_type.MakeGenericType(pi.DeclaringType, pi.PropertyType)
        Dim helper As MysteryPropertyAttributeBaseHelper = Activator.CreateInstance(this_property, pi)
        attr.save = AddressOf helper.save
        attr.retrive = AddressOf helper.retrive
        attr.setup()
        If Not _mystery_property_attributes.ContainsKey(pi.DeclaringType) Then _mystery_property_attributes(pi.DeclaringType) = New HashSet(Of MysteryPropertyAttribute)
        'override declarations
        Dim to_remove As New HashSet(Of MysteryPropertyAttribute)(From x As MysteryPropertyAttribute In _mystery_property_attributes_map(pi) Select x Where TypeOf (x) Is AttrType)
        For Each att_to_remove As AttrType In to_remove
            _mystery_property_attributes(pi.DeclaringType).Remove(att_to_remove)
            _mystery_property_attributes_map(pi).Remove(attr)
        Next
        _mystery_property_attributes(pi.DeclaringType).Add(attr)
        _mystery_property_attributes_map(pi).Add(attr)

    End Sub


    Private _registered_types As New HashSet(Of Type)

    Public Sub registerType(type As Type)
        Try
            If _registered_types.Contains(type) Then Exit Sub
            _registered_types.Add(type)

            Dim CustomAttributes() As Object = type.GetCustomAttributes(False)
            _mystery_attributes(type) = New HashSet(Of MysteryClassAttribute)
            _mystery_attributes_dict(type) = New Dictionary(Of Type, MysteryClassAttribute)

            _mystery_property_attributes(type) = New HashSet(Of MysteryPropertyAttribute)

            'registering the type attributes
            For Each cs As Attribute In CustomAttributes
                Dim at As Type = cs.GetType()
                If Not _attributes.ContainsKey(at) Then _attributes(at) = New HashSet(Of Type)
                _attributes(at).Add(type)
                If TypeOf (cs) Is MysteryClassAttribute Then
                    Dim ma As MysteryClassAttribute = cs
                    ma.used_in = type
                    ma.setUp()
                    _mystery_attributes(type).Add(ma)
                    _mystery_attributes_dict(type)(ma.GetType()) = ma
                End If
            Next

            Dim generic_helper_type As Type = GetType(MysteryPropertyAttributeHelper(Of ,))

            For Each pi As PropertyInfo In type.GetProperties()
                _mystery_property_attributes_map(pi) = New HashSet(Of MysteryPropertyAttribute)
                For Each attr As Attribute In pi.GetCustomAttributes(False)
                    If Not TypeOf (attr) Is MysteryPropertyAttribute Then Continue For
                    Dim mi_attr As MysteryPropertyAttribute = attr
                    If String.IsNullOrEmpty(mi_attr.name) Then mi_attr.name = pi.Name
                    mi_attr.used_in = pi
                    Dim this_property As Type = generic_helper_type.MakeGenericType(pi.DeclaringType, pi.PropertyType)
                    Dim helper As MysteryPropertyAttributeBaseHelper = Activator.CreateInstance(this_property, pi)
                    mi_attr.save = AddressOf helper.save
                    mi_attr.retrive = AddressOf helper.retrive
                    mi_attr.setup()
                    _mystery_property_attributes(type).Add(mi_attr)
                    _mystery_property_attributes_map(pi).Add(mi_attr)
                Next
            Next


            'ineritance recording
            Dim parent As Type = type.BaseType
            While parent IsNot Nothing
                If Not _childs.ContainsKey(parent) Then _childs(parent) = New HashSet(Of Type)
                _childs(parent).Add(type)
                parent = parent.BaseType
            End While

            For Each implemented_interface As Type In type.GetInterfaces()
                If Not _childs.ContainsKey(implemented_interface) Then _childs(implemented_interface) = New HashSet(Of Type)
                _childs(implemented_interface).Add(type)
            Next
        Catch ex As Exception

        End Try

        

    End Sub

#Region "gets"


    Private Function getTypesMarkedWith(attribute_type As Type) As IEnumerable(Of Type)
        If Not _attributes.ContainsKey(attribute_type) Then Return New List(Of Type)
        Return New HashSet(Of Type)(_attributes(attribute_type))
    End Function

    Public Function getTypesMarkedWith(Of T As Attribute)() As IEnumerable(Of Type)
        Return getTypesMarkedWith(GetType(T))
    End Function

    Public Function getChildTypes(Of T)() As IEnumerable(Of Type)
        Return getChildTypes(GetType(T))
    End Function

    Public Function getChildTypes(type As Type) As IEnumerable(Of Type)
        If Not _childs.ContainsKey(type) Then Return New List(Of Type)
        Return New HashSet(Of Type)(_childs(type))
    End Function

    Public Function getMysteryClassAttribute(type As Type) As IEnumerable(Of MysteryClassAttribute)
        If Not _mystery_attributes.ContainsKey(type) Then Return New List(Of MysteryClassAttribute)
        Return New HashSet(Of MysteryClassAttribute)(_mystery_attributes(type))
    End Function

    Public Function getMysteryClassAttribute(Of T)() As IEnumerable(Of MysteryClassAttribute)
        Dim type As Type = GetType(T)
        Return getMysteryClassAttribute(type)
    End Function

    Public Function getMysteryPropertyAttributes(type As Type) As IEnumerable(Of MysteryPropertyAttribute)
        If Not _mystery_property_attributes.ContainsKey(type) Then Return New List(Of MysteryPropertyAttribute)
        Return New HashSet(Of MysteryPropertyAttribute)(_mystery_property_attributes(type))
    End Function

    Public Function getMysteryPropertyAttributes(Of T)() As IEnumerable(Of MysteryPropertyAttribute)
        Dim type As Type = GetType(T)
        Return getMysteryPropertyAttributes(type)
    End Function

    Public Function getMysteryPropertyAttributes(Of TypeOfAttribute As MysteryPropertyAttribute)(type As Type, Optional include_inherits As Boolean = False) As IEnumerable(Of TypeOfAttribute)
        If type Is Nothing Then Return New HashSet(Of TypeOfAttribute)
        Dim result As New HashSet(Of TypeOfAttribute)((From x As MysteryPropertyAttribute In getMysteryPropertyAttributes(type)
                                                       Where TypeOf (x) Is TypeOfAttribute Select DirectCast(x, TypeOfAttribute)))
        If include_inherits OrElse (result.Count = 0 AndAlso type IsNot GetType(Object)) Then
            result.addRange(getMysteryPropertyAttributes(Of TypeOfAttribute)(type.BaseType))
        End If
        Return result
    End Function

    Public Function getMysteryPropertyAttributes(Of TypeOfAttribute As MysteryPropertyAttribute)(property_info As PropertyInfo) As IEnumerable(Of TypeOfAttribute)
        Dim result As New HashSet(Of TypeOfAttribute)((From x As MysteryPropertyAttribute In _mystery_property_attributes_map(property_info)
                                                       Where TypeOf (x) Is TypeOfAttribute Select DirectCast(x, TypeOfAttribute)))
        Return result
    End Function

    Public Function getMysteryPropertyAttributes(Of TypeOfAttribute As MysteryPropertyAttribute, InType)() As IEnumerable(Of TypeOfAttribute)
        Dim type As Type = GetType(InType)
        Return getMysteryPropertyAttributes(Of TypeOfAttribute)(type)
    End Function


    Private Function getMysteryDefaultClassAttribute(type As Type, attr_type As Type) As MysteryClassAttribute
        Dim ma As MysteryClassAttribute = getGlobalObject(Of FastActivator).createInstance(attr_type)
        ma.used_in = type
        ma.setUp()
        _mystery_attributes(type).Add(ma)
        _mystery_attributes_dict(type)(ma.GetType()) = ma
        Return ma
    End Function

    Private _not_default As New HashSet(Of Type)

    Private Shared default_attr_type As Type = GetType(MysteryDefaultClassAttribute)

    Public Function getMysteryClassAttribute(Of T As MysteryClassAttribute)(type As Type) As T
        If Not _mystery_attributes_dict.ContainsKey(type) Then Return Nothing
        Dim att_type As Type = GetType(T)
        If _mystery_attributes_dict(type).ContainsKey(att_type) Then Return _mystery_attributes_dict(type)(att_type)
        If _not_default.Contains(att_type) Then Return Nothing

        If default_attr_type.IsAssignableFrom(att_type) Then
            Return getMysteryDefaultClassAttribute(type, att_type)
        Else
            _not_default.Add(att_type)
            Return Nothing
        End If

    End Function

    Public Function getMysteryClassAttribute(Of T As MysteryClassAttribute, InType)() As T
        Return getMysteryClassAttribute(Of T)(GetType(InType))
    End Function
#End Region

End Class
